home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Environments / Clean 1.2.4 / IOInterface / Window2.icl < prev    next >
Encoding:
Modula Implementation  |  1997-04-23  |  13.9 KB  |  358 lines  |  [TEXT/3PRM]
  1. implementation module Window2;
  2.  
  3. import    StdClass,StdInt,StdBool,StdString;
  4. import    windows, quickdraw;
  5. import    commonDef, windowDevice, windowAccess;
  6.  
  7.  
  8. //    General rules:
  9.  
  10. WindowGetScrolls :: !Window -> (!Int, !Int);
  11. WindowGetScrolls (_,(_,hScroll,_),(_,vScroll,_),_,_,_) = (hScroll, vScroll);
  12.  
  13. WindowSetScrolls :: !Window !Int !Int -> Window;
  14. WindowSetScrolls (wPtr, (hControl,_,hMax), (vControl,_,vMax), pict, updArea, zoom) hScroll vScroll
  15.     = (wPtr, (hControl, hScroll, hMax), (vControl, vScroll, vMax), pict, updArea, zoom);
  16.  
  17. WindowGetThumbs    :: !Window !Toolbox -> (!(!Int, !Int), !Toolbox);
  18. WindowGetThumbs (_,(hControl,_,_),(vControl,_,_),_,_,_) tb
  19.     =    ((hThumb, vThumb), tb2);
  20.     where {
  21.         (hThumb, tb1) = GetCtlValue hControl tb;
  22.         (vThumb, tb2) = GetCtlValue vControl tb1;
  23.     };
  24.  
  25.  
  26. ::    ReadWindowHandle            *s x    :==    !(WindowHandle s)
  27.                                                 -> !Toolbox
  28.                                                 -> (!x, !Toolbox);
  29. ::    DeltaState_and_WindowHandle *s        :==    !s    -> *(!(WindowHandle s)
  30.                                                 -> *(!Toolbox
  31.                                                 -> (!s, !WindowHandle s, !Toolbox)));
  32. ::    DeltaState_and_WindowHandles *s        :==    !s    -> *(![WindowHandle s]
  33.                                                 -> *(!Toolbox
  34.                                                 -> (!s, ![WindowHandle s], !Toolbox)));
  35.  
  36.  
  37. WindowIdOK :: WindowId -> Bool;
  38. WindowIdOK _ = True;
  39.  
  40. ChangeState_and_Windows    :: !(DeltaState_and_WindowHandles *s) !*s !(IOState *s) -> (!*s, !IOState *s);
  41. ChangeState_and_Windows f s ioState
  42.     =     (s1, IOStateSetDevice (IOStateSetToolbox tb1 ioState2) windows1);
  43.     where {
  44.         (windows, ioState1)    = IOStateGetDevice  ioState WindowDevice;
  45.         (tb, ioState2)        = IOStateGetToolbox ioState1;
  46.         (wHs, cursor)        = WindowSystemState_WindowHandles windows;
  47.         (s1, wHs1, tb1)        = f s wHs tb;
  48.         windows1            = WindowSystemState (wHs1, cursor);
  49.     };
  50.  
  51. ChangeState_and_Window :: !(Cond WindowId) !(DeltaState_and_WindowHandle *s) !*s !(IOState *s)
  52.     ->    (!*s, !IOState *s);
  53. ChangeState_and_Window cond f s ioState
  54.     =     ChangeState_and_Windows (ChangeState_and_WindowHandles cond f) s ioState;
  55.  
  56. ChangeState_and_WindowHandles :: !(Cond WindowId) !(DeltaState_and_WindowHandle *s)
  57.              !*s  ![WindowHandle *s] !Toolbox
  58.         ->    (!*s, ![WindowHandle *s],!Toolbox);
  59. ChangeState_and_WindowHandles cond f s [wH=:(wDef, window) : wHs] tb
  60. |    cond (WindowDefGetWindowId wDef)    = (s1, [wH1 : wHs ], tb1);
  61.                                         = (s2, [wH  : wHs1], tb2);
  62.     where {
  63.         (s1, wH1,  tb1) = f s wH tb;
  64.         (s2, wHs1, tb2) = ChangeState_and_WindowHandles cond f s wHs tb;
  65.     };
  66. ChangeState_and_WindowHandles _ _ s wHs tb = (s, wHs, tb);
  67.  
  68.  
  69. ReadWindow :: !(Cond WindowId) !(ReadWindowHandle s x) x !(IOState s) -> (!x, !IOState s);
  70. ReadWindow cond f x ioState
  71.     =    (x1, IOStateSetToolbox tb1 ioState2);
  72.     where {
  73.         (windows,ioState1)    = IOStateGetDevice ioState WindowDevice;
  74.         (tb,     ioState2)    = IOStateGetToolbox ioState1;
  75.         (wHs,     cursor)    = WindowSystemState_WindowHandles windows;
  76.         (x1,     tb1)        = ReadWindowHandles cond f x wHs tb;
  77.     };
  78.  
  79. ReadWindowHandles :: !(Cond WindowId) !(ReadWindowHandle s x) x ![WindowHandle s] !Toolbox
  80.     -> (x, !Toolbox);
  81. ReadWindowHandles cond f x [wH=:(wDef, window) : wHs] tb
  82. |    cond (WindowDefGetWindowId wDef)    = f wH tb;
  83.                                         = ReadWindowHandles cond f x wHs tb;
  84. ReadWindowHandles _ _ x _ tb = (x, tb);
  85.  
  86.  
  87. /*    Changing the values of both scrollbars:
  88.         the new thumbvalues are always adjusted to their extreme values: if the thumb is less than
  89.         its corresponding PictureDomain minimum, it is set to the PictureDomain minimum. If the
  90.         thumb is larger than its corresponding PictureDomain maximum minus the current window
  91.         size, it is set to this latter value.
  92.         The new scrollvalues are adjusted between one and the difference of the corresponding
  93.         PictureDomain extremes.
  94. */
  95.  
  96.  
  97. ::    ScrollBarChange
  98.     =    ChangeThumbs    Int Int | ChangeHThumb    Int | ChangeVThumb  Int
  99.     |    ChangeScrolls    Int Int | ChangeHScroll    Int | ChangeVScroll Int
  100.     |    ChangeHBar        Int Int | ChangeVBar    Int Int;
  101.  
  102.  
  103. ChangeScrollBar    :: !WindowId !ScrollBarChange !*s !(IOState *s) -> (!*s, !IOState *s);
  104. ChangeScrollBar id change s ioState
  105.     =    ChangeState_and_Window ((==) id) (WindowHandleChangeScrollBar change) s ioState;
  106.  
  107. ChangeActiveScrollBar :: !ScrollBarChange !*s !(IOState *s) -> (!*s, !IOState *s);
  108. ChangeActiveScrollBar change s ioState
  109.     =    ChangeState_and_Window WindowIdOK (WindowHandleChangeScrollBar change) s ioState;
  110.  
  111. WindowHandleChangeScrollBar :: !ScrollBarChange !*s !(WindowHandle *s) !Toolbox
  112.     ->    (!*s, ! WindowHandle *s, !Toolbox);
  113. WindowHandleChangeScrollBar change s wH=:(wDef, window) tb
  114. |    not (IsScrollWindow wDef)    = (s,        wH,                    tb );
  115. |    OnlyThumbsChange  change    = (sThumbs,    (wDef, wThumbs ),    tb1);
  116. |    OnlyScrollsChange change    = (sScrolls,(wDef, wScrolls),    tb2);
  117.                                 = (sBar,    (wDef, wBar),        tb3);
  118.     where {
  119.         updateF                            = WindowDefGetUpdate wDef;
  120.         (wThumbs,    sThumbs,    tb1)    = Change_thumbs        change wH updateF s tb;
  121.         (wScrolls,    sScrolls,    tb2)    = Change_scrolls    change wH updateF s tb;
  122.         (wBar,        sBar,        tb3)    = Change_bar        change wH updateF s tb;
  123.     };
  124.  
  125. Change_thumbs :: !ScrollBarChange !(WindowHandle *s) !(UpdateFunction *s) !*s !Toolbox
  126.     ->    (!Window, !*s, !Toolbox);
  127. Change_thumbs change wH=:(wDef, window) f s tb
  128. |    ThumbsChange change        = WindowSetThumbs window newH newV oldH oldV size f s tb2;
  129. |    HThumbChange change        = WindowSetThumbs window newH oldV oldH oldV size f s tb2;
  130.                             = WindowSetThumbs window oldH newV oldH oldV size f s tb2;
  131.     where {
  132.         (w, h)                = size;
  133.         (size,    tb1)        = WindowGetFrameSize wH tb;
  134.         (oldH,    oldV)        = thumbs;
  135.         (thumbs,    tb2)    = WindowGetThumbs window tb1;
  136.         newH                = Max hMin (Min modHval hMax`);
  137.         newV                = Max vMin (Min modVval vMax`);
  138.         modHval                = Align_thumb hVal hMin hMax` hScroll;
  139.         modVval                = Align_thumb vVal vMin vMax` vScroll;
  140.         (hScroll, vScroll)    = WindowGetScrolls window;
  141.         (hVal, vVal)        = ChangeValues change;
  142.         (hMin, vMin)        = topLeft;
  143.         (hMax, vMax)        = rightDown; 
  144.         (topLeft, rightDown)= WindowDefGetPictureDomain wDef;
  145.         hMax`                = hMax - w;
  146.         vMax`                = vMax - h;
  147.     };
  148.  
  149. Change_scrolls :: !ScrollBarChange !(WindowHandle *s) !(UpdateFunction *s) !*s !Toolbox
  150.     ->    (!Window, !*s, !Toolbox);
  151. Change_scrolls change wH=:(wDef, window) f s tb
  152. |    ScrollsChange change    = (WindowSetScrolls wThumbs newHs newVs, sThumbs, tbHV);
  153. |    HScrollChange change    = (WindowSetScrolls wHThumb newHs oldVs, sHThumb, tbH );
  154.                             = (WindowSetScrolls wVThumb oldHs newVs, sVThumb, tbV );
  155.     where {
  156.         (wThumbs, sThumbs, tbHV)= WindowSetThumbs window newHt newVt oldHt oldVt size f s tb2;
  157.         (wHThumb, sHThumb, tbH )= WindowSetThumbs window newHt oldVt oldHt oldVt size f s tb2;
  158.         (wVThumb, sVThumb, tbV )= WindowSetThumbs window oldHt newVt oldHt oldVt size f s tb2;
  159.         (w, h)                    = size;
  160.         (size,        tb1)        = WindowGetFrameSize wH tb;
  161.         (oldHt,        oldVt)        = oldThumbs;
  162.         (oldThumbs,    tb2)        = WindowGetThumbs window tb1;
  163.         newHs                    = Max 1 (Min hVal (hMax - hMin));
  164.         newVs                    = Max 1 (Min vVal (vMax - vMin));
  165.         newHt                    = Max hMin (Min modHt hMax`);
  166.         newVt                    = Max vMin (Min modVt vMax`);
  167.         modHt                    = Align_thumb oldHt hMin hMax` hVal;
  168.         modVt                    = Align_thumb oldVt vMin vMax` vVal;
  169.         (oldHs, oldVs)            = WindowGetScrolls window;
  170.         (hVal, vVal)            = ChangeValues change;
  171.         (hMin, vMin)            = topLeft;
  172.         (hMax, vMax)            = rightDown; 
  173.         (topLeft, rightDown)    = WindowDefGetPictureDomain wDef;
  174.         hMax`                    = hMax - w;
  175.         vMax`                    = vMax - h;
  176.     };
  177.     
  178. Change_bar :: !ScrollBarChange !(WindowHandle *s) !(UpdateFunction *s) !*s !Toolbox
  179.     ->    (!Window, !*s, !Toolbox);
  180. Change_bar (ChangeHBar thumb scroll) wH=:(wDef, window) f s tb
  181.     =    Change_thumbs (ChangeHThumb thumb) (wDef, wScroll) f sScroll tbScroll;
  182.     where {
  183.         (wScroll, sScroll, tbScroll) = Change_scrolls (ChangeHScroll scroll) wH f s tb;
  184.     };
  185. Change_bar (ChangeVBar thumb scroll) wH=:(wDef, window) f s tb
  186.     =    Change_thumbs (ChangeVThumb thumb) (wDef, wScroll) f sScroll tbScroll;
  187.     where {
  188.         (wScroll, sScroll, tbScroll) = Change_scrolls (ChangeVScroll scroll) wH f s tb;
  189.     };
  190.  
  191. OnlyThumbsChange :: !ScrollBarChange    -> Bool;
  192. OnlyThumbsChange (ChangeThumbs _ _)        = True;
  193. OnlyThumbsChange (ChangeHThumb _)        = True;
  194. OnlyThumbsChange (ChangeVThumb _)        = True;
  195. OnlyThumbsChange _                        = False;
  196.  
  197. OnlyScrollsChange :: !ScrollBarChange    -> Bool;
  198. OnlyScrollsChange (ChangeScrolls _ _)    = True;
  199. OnlyScrollsChange (ChangeHScroll _)        = True;
  200. OnlyScrollsChange (ChangeVScroll _)        = True;
  201. OnlyScrollsChange _                        = False;
  202.  
  203. ThumbsChange :: !ScrollBarChange        -> Bool;
  204. ThumbsChange (ChangeThumbs _ _)            = True;
  205. ThumbsChange _                            = False;
  206.  
  207. HThumbChange :: !ScrollBarChange        -> Bool;
  208. HThumbChange (ChangeHThumb _)            = True;
  209. HThumbChange _                            = False;
  210.     
  211. ScrollsChange :: !ScrollBarChange        -> Bool;
  212. ScrollsChange (ChangeScrolls _ _)        = True;
  213. ScrollsChange _                            = False;
  214.  
  215. HScrollChange :: !ScrollBarChange -> Bool;
  216. HScrollChange (ChangeHScroll _)            = True;
  217. HScrollChange _                            = False;
  218.     
  219. ChangeValues :: !ScrollBarChange -> (Int, Int);
  220. ChangeValues (ChangeThumbs  h v) = ( h, v);
  221. ChangeValues (ChangeHThumb  h  ) = ( h, -1);
  222. ChangeValues (ChangeHScroll h  ) = ( h, -1);
  223. ChangeValues (ChangeScrolls h v) = ( h, v);
  224. ChangeValues (ChangeVThumb    v) = (-1, v);
  225. ChangeValues (ChangeVScroll   v) = (-1, v);
  226. ChangeValues (ChangeHBar    t s) = ( t, s);
  227. ChangeValues (ChangeVBar    t s) = ( t, s);
  228.  
  229.  
  230. //    Changing the (active) PictureDomain:
  231.  
  232. ChangePictureDomain    :: !WindowId !PictureDomain !*s !(IOState *s) -> (!*s, !IOState *s);
  233. ChangePictureDomain id pictDomain s ioState
  234. |    ValidPictureDomain pictDomain
  235.     =    ChangeState_and_Windows (ChangePictureDomain` ((==) id) pictDomain (-1)) s ioState;
  236.     =    (s, ioState);
  237.  
  238. ChangeActivePictureDomain :: !PictureDomain !*s !(IOState *s) -> (!*s, !IOState *s);
  239. ChangeActivePictureDomain pictDomain s ioState
  240. |    ValidPictureDomain pictDomain
  241.     =    ChangeState_and_Windows (ChangePictureDomain` WindowIdOK pictDomain (-1)) s ioState;
  242.     =    (s, ioState);
  243.  
  244. ChangePictureDomain` :: !(Cond WindowId) !PictureDomain !WindowPtr !*s ![WindowHandle *s] !Toolbox
  245.     ->    (!*s, ![WindowHandle *s],!Toolbox);
  246. ChangePictureDomain` cond pictDomain prevWindow s [wH=:(wDef, window) : wHs] tb
  247. |    not (cond (WindowDefGetWindowId wDef))    = (s_wHs1,    [wH                    : wHs`], tb1);
  248. |    IsScrollWindow wDef                        = (s1,        [(wDef1, window1)    : wHs ], tb2);
  249.                                             = (s,        [wH1                : wHs ], tb3);
  250.     where {
  251.         wPtr                = WindowGetPtr window;
  252.         (s_wHs1, wHs`,tb1)    = ChangePictureDomain` cond pictDomain wPtr s wHs tb;
  253.         (window1, s1, tb2)    = Set_window_domain window pictDomain updateF s tb;
  254.         (wH1, tb3)            = Change_fixed_window_domain pictDomain prevWindow (wDef1, window) tb;
  255.         wDef1                = WindowDefSetPictureDomain pictDomain (
  256.                                     WindowDefSetMinimumSize (Min minW dX, Min minH dY) wDef);
  257.         (pDMin, pDMax)        = pictDomain;
  258.         (xMin,yMin)            = pDMin;
  259.         (xMax,yMax)            = pDMax;
  260.         dX                    = xMax - xMin;
  261.         dY                    = yMax - yMin;
  262.         (minW, minH)        = WindowDefGetMinimumSize    wDef;
  263.         updateF                = WindowDefGetUpdate        wDef;
  264.     };
  265. ChangePictureDomain` cond pictDomain prevWindow s w_and_hs tb = (s, w_and_hs, tb);
  266.  
  267. ValidPictureDomain :: !PictureDomain -> Bool;
  268. ValidPictureDomain ((xMin, yMin), (xMax, yMax)) = xMin < xMax && yMin < yMax;
  269.  
  270.         
  271. /*    WindowGetFrame yields the visible part of the Picture in the (active) window.
  272.     In case the WindowId is unknown, ((0,0),(0,0)) is returned.
  273. */
  274.  
  275. WindowGetFrame :: !WindowId !(IOState *s) -> (!PictureDomain, !IOState *s);
  276. WindowGetFrame id ioState = ReadWindow ((==) id) WindowHandleGetFrame ((0,0),(0,0)) ioState;
  277.  
  278. ActiveWindowGetFrame :: !(IOState *s) -> (!PictureDomain, !IOState *s);
  279. ActiveWindowGetFrame ioState = ReadWindow WindowIdOK WindowHandleGetFrame ((0,0),(0,0)) ioState;
  280.  
  281. WindowHandleGetFrame :: !(WindowHandle *s) !Toolbox -> (!PictureDomain, !Toolbox);
  282. WindowHandleGetFrame wH=:(_,window) tb
  283.     =    ((thumbs, (hThumb + w, vThumb + h)), tb2);
  284.     where {
  285.         (hThumb, vThumb)= thumbs;
  286.         (thumbs,    tb1)= WindowGetThumbs window tb;
  287.         (w, h)            = size;
  288.         (size,    tb2)    = WindowGetFrameSize wH tb1;
  289.     };
  290.  
  291.  
  292. /*    WindowGetPos yields the current WindowPos of the (active) window.
  293.     In case the WindowId is unknown, (0,0) is returned.
  294. */
  295.  
  296. WindowGetPos :: !WindowId !(IOState *s) -> (!WindowPos, !IOState *s);
  297. WindowGetPos id ioState = ReadWindow ((==) id) WindowHandleGetPos (0,0) ioState;
  298.  
  299. ActiveWindowGetPos :: !(IOState *s) -> (!WindowPos, !IOState *s);
  300. ActiveWindowGetPos ioState = ReadWindow WindowIdOK WindowHandleGetPos (0,0) ioState;
  301.  
  302. WindowHandleGetPos :: !(WindowHandle *s) !Toolbox -> (!WindowPos, !Toolbox);
  303. WindowHandleGetPos wH tb
  304.     =     ((x-WindowScreenBorder, y-WindowScreenBorder-MenuBarWidth-TitleBarWidth), tb1);
  305.     where {
  306.         (wPos,tb1)    = InGrafport (WindowHandleGetPtr wH) (LocalToGlobal (0,0)) tb;
  307.         (x,y)        = wPos;
  308.     };
  309.  
  310.  
  311. /*    Retrieving the active window:
  312.         If the interaction does not contain any windows, the Boolean result is False,
  313.             and the WindowId is 0.
  314.         If the interaction is not active, the Boolean result is also False,
  315.             and the WindowId is of the frontmost window of the interaction.
  316.         Otherwise, the Boolean result is True,
  317.             and the WindowId is of the frontmost window of the interaction.
  318. */
  319.  
  320. GetActiveWindow    :: !(IOState *s) -> (!Bool, !WindowId, !IOState *s);
  321. GetActiveWindow ioState
  322.     =    (exists, id, ioState1);
  323.     where {
  324.         (x, ioState1)    = ReadWindow WindowIdOK GetActiveWindowHandle (False, 0) ioState;
  325.         (exists, id)    = x;
  326.     };
  327.  
  328. GetActiveWindowHandle :: !(WindowHandle *s) !Toolbox -> (!(!Bool, !WindowId), !Toolbox);
  329. GetActiveWindowHandle (wDef, window) tb
  330.     =    ((frontwPtr == WindowGetPtr window, WindowDefGetWindowId wDef), tb1);
  331.     where {
  332.         (frontwPtr, tb1) = FrontWindow tb;
  333.     };
  334.  
  335.  
  336. //    Drawing in the 'visible' part of the (active) windows Picture.
  337.  
  338. DrawInWindowFrame :: !WindowId !(UpdateFunction *s) !*s !(IOState *s) -> (!*s, !IOState *s);
  339. DrawInWindowFrame id f s ioState
  340.     =    ChangeState_and_Window ((==) id) (DrawInWindowHandleFrame f) s ioState;
  341.  
  342. DrawInActiveWindowFrame :: !(UpdateFunction *s) !*s !(IOState *s) -> (!*s, !IOState *s);
  343. DrawInActiveWindowFrame f s ioState
  344.     =    ChangeState_and_Window WindowIdOK (DrawInWindowHandleFrame f) s ioState;
  345.  
  346. DrawInWindowHandleFrame :: !(UpdateFunction *s) !*s !(WindowHandle *s) !Toolbox
  347.     ->    (!*s, ! WindowHandle *s, !Toolbox);
  348. DrawInWindowHandleFrame f s wH=:(wDef, window) tb
  349.     =    (s1, (wDef, window1), tb3);
  350.     where {
  351.         (size,        tb1)    = WindowGetFrameSize wH tb;
  352.         (thumbs,    tb2)    = WindowGetThumbs window tb1;
  353.         (window1,    tb3)    = Draw_in_window window (WindowDefGetDrawMode wDef) fs tb2;
  354.         (s1, fs)            = f [(thumbs, (hThumb + w, vThumb + h))] s;
  355.         (hThumb, vThumb)    = thumbs;
  356.         (w, h)                = size;
  357.     };
  358.